El Mac 7/El Mac 7.iso/De la revista/Ghostscript/files/gs_type1.ps

Text File | 1994-04-25 | 13.8 KB | 433 lines | [TEXT/gsVR]

%    Copyright (C) 1994, 1995 Aladdin Enterprises.  All rights reserved.
%
% This file is part of Aladdin Ghostscript.
%
% Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author
% or distributor accepts any responsibility for the consequences of using it,
% or for whether it serves any particular purpose or works at all, unless he
% or she says so in writing.  Refer to the Aladdin Ghostscript Free Public
% License (the "License") for full details.
%
% Every copy of Aladdin Ghostscript must include a copy of the License,
% normally in a plain ASCII text file named PUBLIC.  The License grants you
% the right to copy, modify and redistribute Aladdin Ghostscript, but only
% under certain conditions described in the License.  Among other things, the
% License requires that the copyright notice and this notice be preserved on
% all copies.

% Type 1 font support code.

% The standard representation for PostScript compatible fonts is described
% in the book "Adobe Type 1 Font Format", published by Adobe Systems Inc.

% Define an augmented version of .buildfont1 that inserts UnderlinePosition
% and UnderlineThickness entries in FontInfo if they aren't there already.
% (This works around the incorrect assumption, made by many word processors,
% that these entries are present in the built-in fonts.)
/.buildfont1
 { dup /FontInfo known not
    { .growfontdict dup /FontInfo 2 dict put }
   if
   dup dup /FontInfo get dup dup
   /UnderlinePosition known exch /UnderlineThickness known and
    { pop pop        % entries already present
    }
    { dup length 2 add dict copy
      dup /UnderlinePosition known not
       { dup /UnderlinePosition 3 index /FontBBox get
         1 get 2 div put        % 1/2 the font descent
       }
      if
      dup /UnderlineThickness known not
       { dup /UnderlineThickness 3 index /FontBBox get
         dup 3 get exch 1 get sub 20 div put    % 1/20 the font height
       }
      if
      1 index /FontInfo get wcheck not { readonly } if
      /FontInfo exch put
    }
   ifelse //.buildfont1
 } bind def

% If DISKFONTS is true, we load individual CharStrings as they are needed.
% (This is intended primarily for machines with very small memories.)
% Initially, the character definition is the file position of the definition;
% this gets replaced with the actual CharString.
% Note that if we are loading characters lazily, CharStrings is writable.

% _Cstring must be long enough to hold the longest CharString for
% a character defined using seac.  This is lenIV + 4 * 5 (for the operands
% of sbw, assuming div is not used) + 2 (for sbw) + 3 * 5 (for the operands
% of seac other than the character codes) + 2 * 2 (for the character codes)
% + 2 (for seac), i.e., lenIV + 43.

/_Cstring 60 string def

% When we initially load the font, we call
%    <index|charname> <length> <readproc> cskip_C
% to skip over each character definition and return the file position instead.
% This substitutes for the procedure
%    <index|charname> <length> string currentfile exch read[hex]string pop
%      [encrypt]
% What we actually store is fileposition * 1000 + length,
%   negated if the string is stored in binary form.

% Older fonts use skip_C rather than cskip_C.
% skip_C takes /readstring or /readhexstring as its third argument,
% instead of the entire reading procedure.
/skipproc_C {string currentfile exch readstring pop} cvlit def
/skip_C
 { //skipproc_C dup 3 4 -1 roll put cvx readonly cskip_C
 } bind def
/cskip_C
 { exch dup 1000 ge 3 index type /nametype ne or
    { % This is a Subrs string, or the string is so long we can't represent
      % its length.  Load it now.
      exch exec
    }
    { % Record the position and length, and skip the string.
      dup currentfile fileposition 1000 mul add
      2 index 3 get /readstring cvx eq { neg } if
      3 1 roll
      dup _Cstring length idiv
       { currentfile _Cstring 3 index 3 get exec pop pop
       } repeat
      _Cstring length mod _Cstring exch 0 exch getinterval
      currentfile exch 3 -1 roll 3 get exec pop pop
    }
   ifelse
 } bind def

% Type1BuildGlyph calls load_C to actually load the character definition.

/load_C        % <charname> <fileposandlength> load_C -
 { dup abs 1000 idiv FontFile exch setfileposition
   CharStrings 3 1 roll
   dup 0 lt
    { neg 1000 mod string FontFile exch readstring }
    { 1000 mod string FontFile exch readhexstring }
   ifelse pop
% If the CharStrings aren't encrypted on the file, encrypt now.
   Private /-| get 0 get
   dup type /nametype ne { dup length 5 sub 5 exch getinterval exec } { pop } ifelse
   dup 4 1 roll put
% If the character is defined with seac, load its components now.
   mark exch seac_C
   counttomark
    { StandardEncoding exch get dup CharStrings exch get
      dup type /integertype eq { load_C } { pop pop } ifelse
    } repeat
   pop        % the mark
 } bind def

/seac_C        % <charstring> seac_C <achar> <bchar> ..or nothing..
 { dup length _Cstring length le
    { 4330 exch _Cstring .type1decrypt exch pop
      dup dup length 2 sub 2 getinterval <0c06> eq    % seac
       { dup length
         Private /lenIV known { Private /lenIV get } { 4 } ifelse
     exch 1 index sub getinterval
% Parse the string just enough to extract the seac information.
% We assume that the only possible operators are hsbw, sbw, and seac,
% and that there are no 5-byte numbers.
     mark 0 3 -1 roll
      { exch
         { { dup 32 lt
              { pop 0 }
          { dup 247 lt
             { 139 sub 0 }
             { dup 251 lt
            { 247 sub 256 mul 108 add 1 1 }
            { 251 sub -256 mul -108 add -1 1 }
               ifelse
             }
            ifelse
          }
         ifelse
           }            % 0
           { mul add 0 }        % 1
         }
        exch get exec
      }
     forall pop
     counttomark 1 add 2 roll cleartomark    % pop all but achar bchar
       }
       { pop    % not seac
       }
      ifelse
    }
    { pop    % punt
    }
   ifelse
 } bind def

% Define an auxiliary procedure for loading a font.
% If DISKFONTS is true and the body of the font is not encrypted with eexec:
%    - Prevent the CharStrings from being made read-only.
%    - Substitute a different CharString-reading procedure.
% (eexec disables this because the implicit 'systemdict begin' hides
% the redefinitions that make the scheme work.)
% We assume that:
%    - The magic procedures (-|, -!, |-, and |) are defined with
%    executeonly or readonly;
%    - The contents of the reading procedures are as defined in bdftops.ps;
%    - The font includes the code
%    <font> /CharStrings <CharStrings> readonly put
/.loadfontdict 6 dict def mark
 /begin            % push this dict after systemdict
  { dup begin
    //systemdict eq { //.loadfontdict begin } if
  } bind
 /end            % match begin
  { currentdict end
    //.loadfontdict eq currentdict //systemdict eq and { end } if
  } bind
 /dict            % leave room for FontFile
  { 1 add dict
  } bind
 /executeonly        % for reading procedures
  { readonly
  }
 /noaccess        % for Subrs strings and Private dictionary
  { readonly
  }
 /readonly        % for procedures and CharStrings dictionary
  {    % We want to take the following non-standard actions here:
      %   - If the operand is the CharStrings dictionary, do nothing;
    %   - If the operand is a number (a file position replacing the
    %    actual CharString), do nothing;
    %   - If the operand is either of the reading procedures (-| or -!),
    %    substitute a different one.
    dup type /dicttype eq        % CharStrings or Private
    count 2 gt and
     { 1 index /CharStrings ne { readonly } if }
     { dup type /arraytype eq        % procedure or data array
    { dup length 5 ge 1 index xcheck and
       { dup 0 get /string eq
         1 index 1 get /currentfile eq and
         1 index 2 get /exch eq and
         1 index 3 get dup /readstring eq exch /readhexstring eq or and
         1 index 4 get /pop eq and
          { /cskip_C cvx 2 packedarray cvx
          }
          { readonly
          }
         ifelse
       }
       { readonly
       }
      ifelse
    }
    { dup type /stringtype eq    % must be a Subr string
       { readonly }
      if
    }
       ifelse
     }
    ifelse
  } bind
counttomark 2 idiv { .loadfontdict 3 1 roll put } repeat pop
.loadfontdict readonly pop
/.loadfont        % <file> .loadfont -
 { mark exch systemdict begin
   DISKFONTS { .loadfontdict begin } if
   % We really would just like systemdict on the stack,
   % but fonts produced by Fontographer require a writable dictionary....
   userdict begin
    % We can't just use `run', because we want to check for .PFB files.
   currentpacking
    { false setpacking .loadfont1 true setpacking }
    { .loadfont1 }
   ifelse
    { stop } if
   end
   DISKFONTS { end } if
   end cleartomark
 } bind def
/.loadfont1        % <file> .loadfont1 <errorflag>
 {    % We would like to use `false /PFBDecode filter',
    % but this occasionally produces a whitespace character as
    % the first of an eexec section, so we can't do it.
    % Also, since the real input file never reaches EOF if we are using
    % a PFBDecode filter (the filter stops just after reading the last
    % character), we must explicitly close the real file in this case.
    % Since the file might leave garbage on the operand stack,
    % we have to create a procedure to close the file reliably.
    { dup read not { -1 } if
      2 copy unread 16#80 eq
       { [ exch dup true /PFBDecode filter cvx exch cvlit
         systemdict /closefile get ]
       }
      if cvx exec
    } stopped
   $error /newerror get and
 } bind def


% The CharStrings are a dictionary in which the key is the character name,
% and the value is a compressed and encrypted representation of a path.
% For detailed information, see the book "Adobe Type 1 Font Format",
% published by Adobe Systems Inc.

% Here are the BuildChar and BuildGlyph implementation for Type 1 fonts.
% The names Type1BuildChar and Type1BuildGlyph are known to the interpreter.

/Type1BuildChar        % <font> <code> Type1BuildChar -
 { 1 index /Encoding get 1 index get .type1build
 } bind def
/Type1BuildGlyph    % <font> <name> Type1BuildGlyph -
 { dup .type1build
 } bind def
/.type1build        % <font> <code|name> <name> .type1build -
 { 3 -1 roll begin
    dup CharStrings exch .knownget not
     { 2 copy eq { exch pop /.notdef exch } if
       QUIET not
    { (Substituting .notdef for ) print = flush }
    { pop }
       ifelse
       /.notdef CharStrings /.notdef get
     } if
    % stack: codename charname charstring
    PaintType 0 ne
     {    % Any reasonable implementation would execute something like
    %    1 setmiterlimit 0 setlinejoin 0 setlinecap
    % here, but apparently the Adobe implementations aren't reasonable.
       currentdict /StrokeWidth .knownget not { 0 } if
       setlinewidth
     } if
    dup type /stringtype eq        % encoded outline
     { 3 -1 roll pop 0 0 moveto outline_C
     }
     { dup type /integertype eq        % file position for lazy loading
    { 3 -1 roll pop
      1 index exch load_C dup CharStrings exch get
      0 0 moveto outline_C
    }
    {                % PostScript procedure
      exch pop
      currentdict end systemdict begin begin   exec   end
    }
       ifelse
     }
    ifelse
   end
 } bind def

% Expand the bounding box before calling setcachedevice.
% Because of square caps and miter joins, the maximum expansion on each side
% is max(sqrt(2), miter_limit) * line_width/2.
% (setcachedevice adds the necessary 1- or 2-pixel fuzz.)
/expandbox_C        % <llx> <lly> <urx> <ury> expandbox_C <...ditto...>
 { PaintType 0 ne
    { 1.415 currentmiterlimit max currentlinewidth mul 2 div
            % llx lly urx ury exp
      5 1 roll 4 index add
            % exp llx lly urx ury+
      5 1 roll 3 index add
            % ury+ exp llx lly urx+
      5 1 roll 2 index sub
            % urx+ ury+ exp llx lly-
      5 1 roll exch sub
            % lly- urx+ ury+ llx-
      4 1 roll
    }
   if
 } bind def

% Make the call on setcachedevice a separate procedure, so we can redefine it
% if the composite font extensions are present.
/setcache_C where        % gs_type0.ps might be loaded first!
 { pop }
 { /setcache_C { setcachedevice pop } bind def }
ifelse

/outline_C        % <charname> <charstring> outline_C -
 {    % In order to make character oversampling work, we must
    % set up the cache before calling .type1addpath.
    % To do this, we must get the bounding box from the FontBBox,
    % and the width and left side bearing from the CharString.
    % (If the FontBBox isn't valid, we punt.)
   currentdict /FontBBox .knownget
    { dup length 4 eq
       { aload pop
     dup 3 index gt 2 index 5 index gt and
      { bbox_C }
      { pop pop pop pop nobbox_C }
     ifelse
       }
       { pop nobbox_C
       }
      ifelse
    }
    { nobbox_C
    }
   ifelse
   PaintType 0 eq { fill } { stroke } ifelse
 } bind def

% Handle the case where FontBBox is not valid.
% In this case, we do the .type1addpath first, then the setcachedevice.
% Oversampling is not possible.
/nobbox_C        % <charname> <charstring> nobbox_C -
 { currentdict /Metrics .knownget
    { 2 index .knownget
       { dup type dup /integertype eq exch /realtype eq or
          {    % <wx>
        exch .type1addpath 0
      }
      { dup length 2 eq
         {    % [<sbx> <wx>]
           exch 1 index 0 get 0 .type1addpath
           1 get 0
         }
         {    % [<sbx> <sby> <wx> <wy>]
           aload pop 5 2 roll .type1addpath
         }
        ifelse
      }
     ifelse
       }
       { .type1addpath currentpoint
       }
      ifelse
    }
    { .type1addpath currentpoint
    }
   ifelse        % stack: wx wy
   pathbbox expandbox_C setcache_C
 } bind def

% Handle the case where FontBBox is valid.
/bbox_C            % <charname> <charstring> <llx> ... <ury> bbox_C -
 {    % Get the width and l.s.b. by parsing the CharString.
    % This isn't needed if we have a 4-element Metrics array,
    % but those are rare.
   4 index .type1getsbw
            % stack: cname cstring llx lly urx ury sbx sby wx wy
   currentdict /Metrics .knownget
    { 10 index .knownget
       { dup type dup /integertype eq exch /realtype eq or
          {    % <wx>
        exch pop exch pop 0
      }
      { 5 1 roll pop pop pop pop
        dup length 2 eq
         {    % [<sbx> <wx>]
           aload pop 0 exch 0
         }
         {    % [<sbx> <sby> <wx> <wy>]
           aload pop
         }
        ifelse
      }
     ifelse
       }
      if
    }
   if
   8 4 roll expandbox_C
   9 index 7 1 roll setcache_C
   .type1addpath pop
 } bind def